home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 3.2 / Ham Radio Version 3.2 (Chestnut CD-ROMs)(1993).ISO / cw / cwpract / cw.pas < prev    next >
Pascal/Delphi Source File  |  1987-02-27  |  45KB  |  1,492 lines
  1. program cw;
  2.  
  3. type
  4.   line = string[82];
  5.   names = string[80];
  6.   screen_array = array[1..4000] of byte;
  7.   regpack     = record
  8.                    ax,bx,cx,dx,bp,si,ds,es,flags:integer;
  9.                  end;
  10.  
  11.   cfgtype = record
  12.               tone_freq_str  : string[4];
  13.               send_speed_str : string[2];
  14.               char_speed_str : string[2];
  15.               main_fg        : integer;
  16.               main_bg        : integer;
  17.               box_fg         : integer;
  18.               box_bg         : integer;
  19.               hilite         : integer;
  20.             end;
  21.  
  22. const
  23.   version      = '2.14';
  24.   min_speed    = 3;
  25.   max_speed    = 50;
  26.   blink_yes    = true;
  27.   blink_no     = false;
  28.   echo_yes     = true;
  29.   echo_no      = false;
  30.  
  31.   nul          = #0;
  32.   bel          = #7;
  33.   cr           = #13;
  34.   lf           = #10;
  35.   esc          = #27;
  36.  
  37.   numberchars = 35; {1 less than actual number}
  38.  
  39.   characters : array[0..numberchars] of char =
  40.                'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
  41.  
  42.   number_letters = 25; {1 less than actual}
  43.  
  44.   letters    : array[0..number_letters] of char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  45.  
  46.   numbers    : array[0..9] of char = '0123456789';
  47.  
  48.   {Additional words can be added to the list below if the constant numberwords
  49.    is increased accordingly}
  50.  
  51.   numberwords = 272; {This is 1 less than the actual number}
  52.  
  53.   words      : array[0..numberwords] of string[10] =
  54.                ('ADD','ADVICE','ADVISE','AFTER','AGAIN','AIM','AIR',
  55.                 'ALL','ALWAYS','ALSO','AM','AMONG','AN','AND','ANY',
  56.                 'ARE','AROUND','AS','ASK','ASKED','AWAY',
  57.                 'AT','BACK','BAD','BAND','BE','BEEN','BEFORE','BEST',
  58.                 'BETTER','BID','BIG','BIT','BOTH','BRING','BUT',
  59.                 'BUY','BY','CALL','CAME','CAN','CAR','CENT','CITY',
  60.                 'COLD','COME','COULD','DAY','DEAR','DID','DIE',
  61.                 'DO','DOES','DONE','DONT','DOWN','DRAW','DUE','EACH',
  62.                 'EAT','END','ES','EVEN','EVERY','FACT',
  63.                 'FALL','FAR','FAST','FB','FEW','FIND','FIRST','FIVE','FOR',
  64.                 'FOUND','FROM','FRONT','FULL','FUNNY','GAVE','GET',
  65.                 'GIVE','GO','GOES','GOING','GOOD','GOT','GROW',
  66.                 'HAD','HALF','HAM','HAND','HAS','HAVE','HE','HEAR',
  67.                 'HELP','HER','HERE','HIM','HIS','HOME','HOT','HOUSE',
  68.                 'HOW','IF','IN','INTO','IS','IT','JUMP','JUST',
  69.                 'KEEP','KEY','KNEW','KNOW','LAST','LAW','LEFT','LESS',
  70.                 'LET','LIE','LIGHT','LIKE','LITTLE','LIVE',
  71.                 'LONG','LOOK','LOT','LOVE','LOW','MADE','MAKE','MAN',
  72.                 'MANY','MATTER','MAY','ME','MIGHT','MIND','MORE','MUCH','MUST',
  73.                 'MY','MYSELF','NAME','NET','NEW','NEXT','NO','NOR','NOT','NOW',
  74.                 'OF','OFF','OIL','OLD','OM','ON','ONCE','ONLY',
  75.                 'OPEN','OR','OTHER','OUT','OVER','OWE','OWN','PART',
  76.                 'PAY','PER','PLAY','POWER','PULL','PUT',
  77.                 'QRM','QRN','QRX','QST','QTH','RADIO','RAIN',
  78.                 'RAN','READ','RIGHT','ROUND','RST','RUN','SAID','SAME',
  79.                 'SAT','SAW','SAY','SEA','SEE','SHALL','SHE','SHOULD',
  80.                 'SHOW','SMALL','SO','SOME','SOON','START','STOP','SUCH',
  81.                 'TAKE','TAKEN','TELL','THAN','THANK','THAT','THE','THEM','THEN','THERE',
  82.                 'THEY','THING','THINK','THIS','THOSE','TIME','TO','TODAY',
  83.                 'TOO','TRY','UNDER','UNTIL','UP','UPON',
  84.                 'UR','US','USE','VERY','VY','WALK','WANT','WAS',
  85.                 'WAY','WE','WELL','WENT','WERE','WHAT','WHEN','WHERE',
  86.                 'WHICH','WHILE','WHO','WHOLE','WHOSE','WHY',
  87.                 'WILL','WITH','WISH','WORK','WORLD','WOULD','WRITE','WRONG',
  88.                 'WX','W1AW','YEARS','YET','YL','YOU','YOUR','YOURS',
  89.                 '559','569','579','589','599');
  90.  
  91.   any_key       = 'Any Key Aborts';
  92.   any_continue  = 'Any Key Continues';
  93.   esc_msg       = '<ESC> Quits';
  94.  
  95. var
  96.   cfgfile: file of cfgtype;
  97.   cfgrec : cfgtype;
  98.  
  99.   real_screen : screen_array Absolute $b800:$0000;
  100.   tmp_screen : screen_array;
  101.  
  102.   main_fg,main_bg,box_fg,box_bg,
  103.   code,freq,i,marktime,space_marktime,q,rand_no,
  104.   textpos,x,xpos,xx,ypos,yy : integer;
  105.  
  106.   bit,ch,kch,menu_choice : char;
  107.  
  108.   send_speed,char_speed : real;
  109.  
  110.   textline: line;
  111.  
  112.   abort,firstpass,hide,ok : boolean;
  113.  
  114.   exit_msg : string[22];
  115.   mode : string[14];
  116.  
  117. function allcaps(instring:line):line;
  118. var
  119.   temp : line;
  120. begin
  121.   temp:='';
  122.   for i:=1 to length(instring) do temp:=temp+upcase(instring[i]);
  123.   allcaps:=temp;
  124. end;
  125.  
  126. procedure beep; begin write(#7);end;
  127.  
  128. procedure blip;begin sound(400);delay(25);nosound;delay(300);end;
  129.  
  130. procedure buzz;begin
  131.   for i:=1 to 7 do begin
  132.    sound(100);delay(10);sound(200);delay(10);nosound;
  133.   end;
  134. end;
  135.  
  136. procedure open_wndo (x1,y1,x2,y2,fg,bg : integer; boxname : names; blnk : boolean);
  137. begin
  138.   window(x1+1,y1+1,x2-1,y2-1);
  139.   clrscr;
  140.   window (x1,y1,x2,y1+1);
  141.   textbackground(cfgrec.box_bg);
  142.   gotoxy(1,1);
  143.   x := x2-x1;
  144.   if length(boxname) > x then boxname[0] := chr(x-4);
  145.   textcolor(cfgrec.box_fg);
  146.   write('╔');
  147.   if blnk then textcolor(cfgrec.box_fg + blink) else textcolor(cfgrec.box_fg);
  148.   write (boxname);
  149.   textcolor(cfgrec.box_fg);
  150.   for q := x1+length(boxname)+1 TO x2-1 do write('═');
  151.   write('╗');
  152.   for q := 2 to y2-y1 DO
  153.     begin
  154.       window (x1,y1,x2,y1+q+1);
  155.       gotoxy(1,q); write('║');
  156.       if blnk then clreol;
  157.       gotoxy(x2-x1+1,q); write('║');
  158.     end;
  159.   window(x1,y1,x2,y2+1);
  160.   gotoxy(1,y2-y1+1);
  161.   write('╚');
  162.   for q := x1+1 to x2-1 do write('═');
  163.   write('╝');
  164.   window(x1+2,y1+1,x2-2,y2-1);
  165.   clrscr;
  166. end;
  167.  
  168. procedure close_wndo;begin window(1,1,80,23);end;
  169.  
  170. procedure scrn_off;
  171. begin
  172.      inline($52/$50/$ba/$d8/$03/$b0/$21/$ee/$58/$5a)
  173. end;
  174.  
  175. procedure scrn_on;
  176. begin
  177.      inline($52/$50/$ba/$d8/$03/$b0/$29/$ee/$58/$5a)
  178. end;
  179.  
  180. procedure save_screen;
  181. begin
  182.     xx := wherex;
  183.     yy := wherey;
  184.     scrn_off;
  185.     move(real_screen, tmp_screen, 3680);
  186.     scrn_on;
  187. end;
  188.  
  189. procedure restore_screen;
  190. var
  191.    numline : integer;
  192. begin
  193.     clrscr;
  194.     window(1,1,80,23);
  195.     scrn_off;
  196.     move(tmp_screen, real_screen, 3680);
  197.     scrn_on;
  198.     gotoxy(xx,yy);
  199.     textcolor(cfgrec.main_fg);
  200.     textbackground(cfgrec.main_bg);
  201. end;
  202.  
  203. procedure statusline;begin
  204.   window(1,1,80,25);
  205.   xpos:=wherex;ypos:=wherey;
  206.   gotoxy(1,25);clreol;
  207.   gotoxy(1,25);write(mode);
  208.   gotoxy(18,25);write('SSpd: ',cfgrec.send_speed_str);
  209.   gotoxy(28,25);write('CSpd: ',cfgrec.char_speed_str);
  210.   gotoxy(38,25);write('Tone: ',cfgrec.tone_freq_str);
  211.   gotoxy(50,25);write('Text: ');
  212.   if hide then write('Off') else write('On');
  213.   gotoxy(61,25);write(exit_msg);
  214.   gotoxy(xpos,ypos);
  215.   window(1,1,80,23);
  216. end;
  217.  
  218. procedure dot;begin
  219.   if keypressed then abort:=true else abort:=false;
  220.   sound(freq);
  221.   delay(marktime);
  222.   nosound;
  223. end;
  224.  
  225. procedure dash;begin
  226.   if keypressed then abort:=true else abort:=false;
  227.   sound(freq);
  228.   delay(3*marktime);
  229.   nosound;
  230. end;
  231.  
  232. procedure bitspace;begin
  233.   if keypressed then abort:=true else abort:=false;
  234.   delay(marktime);
  235. end;
  236.  
  237. procedure charspace;begin
  238.   if keypressed then abort:=true else abort:=false;
  239.   delay(2*space_marktime);
  240. end;
  241.  
  242. procedure wordspace;begin
  243.   if keypressed then abort:=true else abort:=false;
  244.   delay(6*space_marktime);
  245. end;
  246.  
  247. procedure sendchrx(ch:char);   {character sent without charspace}
  248. var
  249.   mch : string[8];
  250.  
  251. begin
  252.   ch:=upcase(ch);
  253.   case ch of
  254.     ' ':mch:=' ';
  255.     'A':mch:='01';
  256.     'B':mch:='1000';
  257.     'C':mch:='1010';
  258.     'D':mch:='100';
  259.     'E':mch:='0';
  260.     'F':mch:='0010';
  261.     'G':mch:='110';
  262.     'H':mch:='0000';
  263.     'I':mch:='00';
  264.     'J':mch:='0111';
  265.     'K':mch:='101';
  266.     'L':mch:='0100';
  267.     'M':mch:='11';
  268.     'N':mch:='10';
  269.     'O':mch:='111';
  270.     'P':mch:='0110';
  271.     'Q':mch:='1101';
  272.     'R':mch:='010';
  273.     'S':mch:='000';
  274.     'T':mch:='1';
  275.     'U':mch:='001';
  276.     'V':mch:='0001';
  277.     'W':mch:='011';
  278.     'X':mch:='1001';
  279.     'Y':mch:='1011';
  280.     'Z':mch:='1100';
  281.     '1':mch:='01111';
  282.     '2':mch:='00111';
  283.     '3':mch:='00011';
  284.     '4':mch:='00001';
  285.     '5':mch:='00000';
  286.     '6':mch:='10000';
  287.     '7':mch:='11000';
  288.     '8':mch:='11100';
  289.     '9':mch:='11110';
  290.     '0':mch:='11111';
  291.     '-':mch:='10001';
  292.     '/':mch:='10010';
  293.     '?':mch:='001100';
  294.     ',':mch:='110011';
  295.     '.':mch:='010101';
  296.     '!':mch:='01010';
  297.     '@':mch:='01000';
  298.     '#':mch:='10110';
  299.     '$':mch:='000101';
  300.     '*':mch:='10001';
  301.     else mch:='\ ';
  302.   end;
  303.   for i:=1 to length(mch) do begin
  304.     bit:=copy(mch,i,1);
  305.     case bit of
  306.       '\':bitspace;
  307.       ' ':wordspace;
  308.       '0':dot;
  309.       '1':dash;
  310.     end;
  311.     bitspace;
  312.   end;
  313.   charspace;
  314. end;
  315.  
  316. procedure sendchr(ch:char;withecho:boolean);
  317. label endit;
  318. begin
  319.   sendchrx(ch);
  320.   if abort then goto endit;
  321.   if withecho and not hide then write(upcase(ch));
  322.   charspace;
  323.   endit:
  324. end;
  325.  
  326. procedure sendstr(textline:line;withecho:boolean);
  327. label endit;
  328. begin
  329.   for textpos:=1 to length(textline) do begin
  330.     sendchr(textline[textpos],withecho);
  331.     if abort then goto endit;
  332.   end;
  333.   endit:
  334. end;
  335.  
  336. procedure sendline(textline:line;withecho:boolean);
  337. begin
  338.   sendstr(textline,withecho);
  339.   if not abort then writeln;
  340. end;
  341.  
  342. procedure disk;
  343. label endit;
  344. var
  345.   ch       : char;
  346.   filename : string[14];
  347.   sendfile : text;
  348.   select   : char;
  349.   goodfile : boolean;
  350. begin
  351.   abort:=false;
  352.   mode:='DISK';
  353.   exit_msg:=any_key;
  354.   statusline;
  355.   if firstpass then clrscr else begin writeln;writeln;end;
  356.   textcolor(cfgrec.hilite);
  357.   writeln('Disk File');
  358.   for i:=1 to 9 do write(chr(196));writeln;
  359.   textcolor(cfgrec.main_fg);
  360.   repeat
  361.     goodfile:=false;writeln;
  362.     write('* Enter Disk File Name (Enter QUIT to Abort) > ');readln(filename);writeln;
  363.     filename:=allcaps(filename);
  364.     if filename='QUIT' then goto endit;
  365.     assign(sendfile,filename);
  366.     {$I-} reset(sendfile) {$I+};
  367.     if ioresult=0 then goodfile:=true;
  368.     if not goodfile then begin
  369.       buzz;
  370.       writeln;writeln('* File Does Not Exist');
  371.     end;
  372.   until goodfile;
  373.   if hide then write('* No Text Displayed...');
  374.   while (not abort) and (not eof(sendfile)) do begin
  375.     readln(sendfile,textline);
  376.     textline:=textline+cr+lf;
  377.     sendstr(textline,echo_yes);
  378.   end;
  379.   writeln;writeln;write('* Press Any Key to Continue...');
  380.   repeat until keypressed;
  381.   close(sendfile);
  382.   endit:
  383.   firstpass:=false;
  384. end;
  385.  
  386. procedure qso;
  387. const
  388.  
  389.   number_antennas = 13;  {1 less than the acutal number}
  390.  
  391.   antennas    : array[0..number_antennas] of string[15] =
  392.                 ('DELTA LOOP','DIPOLE','FOLDED DIPOLE','HORIZONTAL LOOP',
  393.                  'INVERTED VEE','LOG PERIODIC','LONGWIRE',
  394.                  'PHASED VERTICAL ARRAY','QUAD','TRAP VERTICAL',
  395.                  'TRIBAND YAGI','VERTCAL','WINDOM','ZEPP');
  396.  
  397.   number_names = 26; {1 less than the acutal number}
  398.  
  399.   names       : array[0..number_names] of string[6] =
  400.                 ('AL','ANN','BETTY','BILL','BOB','CARL','DON',
  401.                  'EARL','FRED','JACK','JIM','JOAN','JOE','KEN','LEE',
  402.                  'LIZ','MARY','MIKE','PAT','PAUL','RON','SAM','SUE',
  403.                  'TIM','TED','TOM','VERN');
  404.  
  405.   number_rigs = 12; {1 less than the actual number}
  406.  
  407.   rigs        : array[0..number_rigs] of string[15] =
  408.                 ('COLLINS S-LINE','COLLINS KWM-380','HEATH SB-102',
  409.                  'MOMEBREW','ICOM IC-720A','ICOM IC-745','ICOM IC-751',
  410.                  'KENWOOD TS-520E','KENWOOD TS-820S','KENWOOD TS940S',
  411.                  'TEMPO ONE','YAESU FT-101E','YAESU FT-757GX');
  412.  
  413.   number_cities = 22; {1 less than the actual number}
  414.  
  415.   cities      : array[0..number_cities] of string[15] =
  416.                 ('BEDROCK','CAPITAL CITY','CENTERVILLE','COLUMBIA',
  417.                  'EASTVALE','GREEN VALLEY','GREENVILLE','HIGHLANDS',
  418.                  'HILLSDALE','INDEPENDENCE','JONESTOWN','LAKE CITY',
  419.                  'MAYBERRY','OAK FALLS','ROCK SPRINGS','SMITHVILLE',
  420.                  'SOUTHLAKE','SPRINGFIELD','STONE CITY','TIMBERVIEW',
  421.                  'UNIVERSITY PARK','VALLEY CENTER','WEST BAY');
  422.  
  423.   states      : array[0..49] of string[2] =
  424.                 ('AL','AK','AZ','AR','CA','CO','CT','DE','FL','GA',
  425.                  'HI','ID','IL','IN','IA','KS','KY','LA','ME','MD',
  426.                  'MA','MI','MN','MS','MO','MT','NE','NV','NH','NJ',
  427.                  'NM','NY','NC','ND','OH','OK','OR','PA','RI','SC',
  428.                  'SD','TN','TX','UT','VT','VA','WA','WV','WI','WY');
  429.  
  430.   number_prefixes = 5; {1 less than actual}
  431.  
  432.   prefixes    : array[0..number_prefixes] of string[2] =
  433.                 ('W','K','WA','WB','WD','KA');
  434.  
  435.   number_wxs = 6; {1 less than actual}
  436.  
  437.   wxs         : array[0..number_wxs] of string[5] =
  438.                 ('COLD','COOL','HOT','WARM','RAIN','SNOW','CLEAR');
  439.  
  440. var
  441.   age, height, readability, strength, temp, years : integer;
  442.   ant_str, city, rig_str : string[15];
  443.   age_str,prefix,temp_str,years_str : string[2];
  444.   height_str,state : string[2];
  445.   callfrom, callto : string[6];
  446.   name : string[6];
  447.   rst,suffix  : string[3];
  448.   readability_str, region, strength_str : string[1];
  449.   wx : string[5];
  450.  
  451.   procedure getdata;
  452.   begin
  453.     randomize;
  454.     prefix:=prefixes[random(number_prefixes)];
  455.     region:=numbers[random(9)];
  456.     suffix:='';for i:=1 to 3 do suffix:=suffix+letters[random(25)];
  457.     callfrom:=prefix+region+suffix;
  458.     prefix:=prefixes[random(number_prefixes)];
  459.     region:=numbers[random(9)];
  460.     suffix:='';for i:=1 to 3 do suffix:=suffix+letters[random(25)];
  461.     callto:=prefix+region+suffix;
  462.     age:=random(60)+10;str(age,age_str);
  463.     years:=random(age-9);if years=0 then years:=1;str(years,years_str);
  464.     rig_str:=rigs[random(number_rigs)];
  465.     ant_str:=antennas[random(number_antennas)];
  466.     height:=random(50)+20;str(height,height_str);
  467.     name:=names[random(number_names)];
  468.     randomize;
  469.     readability:=4+random(2);str(readability,readability_str);
  470.     strength:=3+random(6);str(strength,strength_str);
  471.     rst:=readability_str+strength_str+'9';
  472.     wx:=wxs[random(number_wxs)];
  473.     if wx='HOT' then temp:=85+random(15)
  474.     else if wx='WARM' then temp:=70+random(15)
  475.     else if wx='COOL' then temp:=40+random(20)
  476.     else if wx='COLD' then temp:=random(40)
  477.     else if wx='SNOW' then temp:=20+random(12)
  478.     else if wx='RAIN' then temp:=32+random(50)
  479.     else temp:=random(100);
  480.     str(temp,temp_str);
  481.     city:=cities[random(number_cities)];
  482.     state:=states[random(49)];
  483.   end;
  484.  
  485. begin
  486.   mode:='QSO';
  487.   exit_msg:=any_key;
  488.   statusline;
  489.   abort:=false;
  490.   if firstpass then clrscr else begin writeln;writeln;end;
  491.   textcolor(cfgrec.hilite);
  492.   writeln('Simulated QSO');
  493.   for i:=1 to 13 do write(chr(196));writeln;writeln;
  494.   textcolor(cfgrec.main_fg);
  495.   if hide then write('* No Text Displayed...');
  496.   getdata;
  497.   if not abort then begin
  498.     sendline('CQ CQ CQ DE '+callfrom+' K',echo_yes);delay(1500);writeln;
  499.   end;
  500.   if not abort then sendline(callto+' DE '+callfrom+' ',echo_yes);
  501.   if not abort then sendline('TNX FER CALL OM - UR RST IS '+rst+' - ',echo_yes);
  502.   if not abort then sendline('NAME HR IS '+name+' ES QTH IS '+city+', '+state+' - ',echo_yes);
  503.   if not abort then sendline('AGE IS '+age_str+' ES HAVE BIN A HAM FER '+years_str+' YRS - ',echo_yes);
  504.   if not abort then sendline('RIG IS '+rig_str+' ES ANT IS '+ant_str+' AT '+height_str+' FEET - ',echo_yes);
  505.   if not abort then sendline('WX IS '+wx+'.  TEMP IS '+temp_str+'F - ',echo_yes);
  506.   if not abort then sendline('TNX FER NICE QSO OM - ',echo_yes);
  507.   if not abort then sendline('73 ES CUL '+callto+' DE '+callfrom+' $',echo_yes);
  508.   writeln;write('* Press Any Key to Continue...');
  509.   repeat until keypressed;
  510.   firstpass:=false;
  511. end;
  512.  
  513. procedure type_test;
  514. var
  515.   tstr : string[2];
  516.   recv_speed,send_speed,denominator,no_sent,adj_no_sent,no_correct,
  517.   adj_no_correct,numerator,time,treal,wdspaces : real;
  518.   hour,min,sec,hsec : byte {string[2]};
  519.   hour1,min1,sec1,hsec1,hour2,min2,sec2,hsec2,
  520.   code,ehour,emin,esec,ehsec: integer;
  521.  
  522.   bit,cwch,ch   : char;
  523.   correct,exit      : boolean;
  524.   i,marktime, speed : integer;
  525.  
  526.   procedure gettime;
  527.   var register:regpack;
  528.   begin
  529.     with register do begin
  530.       ax:=$2c00;
  531.       msdos(register);
  532.       hour:=hi(cx);
  533.       min:=lo(cx);
  534.       sec:=hi(dx);
  535.       hsec:=lo(dx);
  536.     end;
  537.   end;
  538.  
  539.   procedure calc_time;
  540.   begin
  541.     if min1>min2 then begin hour2:=hour2-1;min2:=min2+60;end;
  542.     if sec1>sec2 then begin min2:=min2-1;sec2:=sec2+60;end;
  543.     if hsec1>hsec2 then begin sec2:=sec2-1;hsec2:=hsec2+100;end;
  544.     ehour:=hour2-hour1;emin:=min2-min1;esec:=sec2-sec1;ehsec:=hsec2-hsec1;
  545.     str(ehour,tstr);val(tstr,treal,code);time:=3600*treal;
  546.     str(emin,tstr);val(tstr,treal,code);time:=time+60*treal;
  547.     str(esec,tstr);val(tstr,treal,code);time:=time+treal;
  548.     str(ehsec,tstr);val(tstr,treal,code);time:=time+treal/100;
  549.   end;
  550.  
  551.   procedure get_chr;
  552.   var chno : integer;
  553.   begin
  554.     repeat chno:=random(numberchars);until chno>0;
  555.     cwch:=characters[chno];
  556.   end;
  557.  
  558. begin
  559.   mode:='TYPETEST';
  560.   exit_msg:='<ESC> Exits';
  561.   statusline;
  562.   if firstpass then clrscr else begin writeln;writeln;end;
  563.   textcolor(cfgrec.hilite);
  564.   writeln('Type Test');
  565.   for i:=1 to 9 do write(chr(196));writeln;writeln;
  566.   textcolor(cfgrec.main_fg);
  567.   writeln('* Press Correct Key When Character Sent.');writeln;
  568.   if hide then write('* No Text Displayed...');
  569.   exit:=false;no_sent:=0;no_correct:=0;
  570.   randomize;
  571.   gettime;
  572.   hour1:=hour;min1:=min;sec1:=sec;hsec1:=hsec;
  573.   repeat
  574.     get_chr;
  575.     correct:=false;
  576.     repeat
  577.       gettime;                {do not time "exit" character}
  578.       sendchrx(cwch);
  579.       no_sent:=no_sent+1;
  580.       repeat until keypressed;
  581.       read(kbd,ch);ch:=upcase(ch);
  582.       if (ch=cwch) then begin
  583.         correct:=true;
  584.         no_correct:=no_correct+1;
  585.         if not hide then write(upcase(ch));
  586.       end
  587.       else if not (ch=esc) then buzz;
  588.     until correct or (ch=esc);
  589.     if ch=esc then abort:=true;
  590.   until abort;
  591.   hour2:=hour;min2:=min;sec2:=sec;hsec2:=hsec;
  592.   calc_time;if time=0 then time:=1.0;
  593.   no_sent:=no_sent-1;                     {last character is ignored}
  594.   wdspaces:=no_sent/5;wdspaces:=0.71*wdspaces;
  595.   adj_no_sent:=no_sent+wdspaces;
  596.   send_speed:=adj_no_sent/time;
  597.   writeln;writeln;
  598.   writeln('* Send Speed            = ',1.58*12*send_speed:5:1,' wpm');
  599.   wdspaces:=no_correct/5;wdspaces:=0.71*wdspaces;
  600.   adj_no_correct:=no_correct+wdspaces;
  601.   recv_speed:=adj_no_correct/time;
  602.   writeln('* Approx. Receive Speed = ',1.58*12*recv_speed:5:1,' wpm');
  603.   if no_correct>0 then numerator:=100*(no_correct)
  604.   else numerator:=0;
  605.   denominator:=no_sent;if denominator=0 then denominator:=1;
  606.   writeln('* Percentage Correct    = ',numerator/denominator:4:0);
  607.   writeln;write('* Press Any Key to Continue...');
  608.   repeat until keypressed;
  609.   firstpass:=false;
  610. end;
  611.  
  612. procedure groups;
  613. label endit;
  614. var chr2send,i,j:integer;
  615. begin
  616.   mode:='GROUPS';
  617.   exit_msg:=any_key;
  618.   statusline;
  619.   if firstpass then clrscr else begin writeln;writeln;end;
  620.   textcolor(cfgrec.hilite);
  621.   writeln('Random Code Groups');
  622.   for i:=1 to 19 do write(chr(196));writeln;writeln;
  623.   textcolor(cfgrec.main_fg);
  624.   if hide then write('* No Text Displayed...');
  625.   repeat
  626.     randomize;
  627.     for i:=1 to 13 do
  628.       begin
  629.         for j:=1 to 5 do begin
  630.           repeat chr2send:=random(numberchars);until chr2send>0;
  631.           sendchr(characters[chr2send],echo_yes);
  632.           if abort then goto endit;
  633.         end;
  634.         sendchr(' ',echo_yes);
  635.       end;
  636.     writeln;
  637.   until keypressed;
  638.   endit:
  639.   writeln;writeln;write('* Press Any Key to Continue...');
  640.   repeat until keypressed;
  641.   firstpass:=false;
  642. end;
  643.  
  644. procedure help;
  645. begin
  646.   mode:='HELP';
  647.   exit_msg:=any_continue;
  648.   statusline;
  649.   save_screen;
  650.   open_wndo(1,5,80,20,cfgrec.box_fg,cfgrec.box_bg,'[ Help ]',blink_no);
  651.   writeln;writeln('COMMANDS:');writeln;
  652.   writeln('<D>isk          - Sends disk text file.  Enter name of file when prompted.');
  653.   writeln('<E>nter Message - Sends message typed by user when prompted.');
  654.   writeln('<G>roups        - Sends 5 letter groups of random letters.');
  655.   writeln('<I>nformation   - Information on program and author.');
  656.   writeln('<K>eyboard Send - Send individual characters when typed.');
  657.   writeln('<P>armeters     - Set code speed and oscillator tone.');
  658.   writeln('<Q>SO           - Simulated QSO (radio contact) with another station.');
  659.   writeln('<T>ype Test     - Type correct key when character sent.');
  660.   writeln('<U>tilities     - Set screen colors, hide text, test code speed.');
  661.   writeln('<W>ords         - Sends random words of up to 6 letters in length.');
  662.   repeat until keypressed;
  663.   restore_screen;
  664. end;
  665.  
  666. procedure info;begin
  667.   mode:='CW INFORMATION';
  668.   exit_msg:=any_continue;
  669.   statusline;
  670.   save_screen;
  671.   open_wndo(8,4,72,21,cfgrec.box_fg,cfgrec.box_bg,'[ CW Information ]',blink_no);
  672.   textcolor(cfgrec.box_fg);
  673.   writeln;
  674.   writeln('CW was written to help prospective hams learn the Morse Code');
  675.   writeln('and existing hams to increase their code speed in order to');
  676.   writeln('upgrade to a higher class of license.  Shareware contri-');
  677.   writeln('butions are welcomed but not required.  If you have any');
  678.   writeln('comments, suggestions for improvement, or corrections, please');
  679.   writeln('contact me as shown below:');
  680.   writeln;
  681.   writeln('               M. Lee Murrah');
  682.   writeln('               10 Cottage Grove Woods, S.E.');
  683.   writeln('               Cedar Rapids, IA 52403');
  684.   writeln('               Tel.: 319-365-6530');
  685.   writeln('               Compuserve ID: 71016,1355');
  686.   writeln('               GENIE Address: L.MURRAH');
  687.   repeat until keypressed;
  688.   restore_screen;
  689. end;
  690.  
  691. procedure keyboard_send;
  692. begin
  693.   mode:='KEYBOARD SEND';
  694.   exit_msg:=esc_msg;
  695.   statusline;
  696.   if firstpass then clrscr else begin writeln;writeln;end;
  697.   textcolor(cfgrec.hilite);
  698.   writeln('Send from Keyboard');
  699.   for i:=1 to 18 do write(chr(196));writeln;writeln;
  700.   textcolor(cfgrec.main_fg);
  701.   writeln('* Type Character AFTER Last Character Sent');writeln;
  702.   repeat
  703.     if hide then write('* No Text Displayed...');
  704.     read(kbd,kch);kch:=upcase(kch);
  705.     if kch<>esc then begin write(kch);sendchr(kch,echo_no);end;
  706.   until kch=esc;
  707.   firstpass:=false;
  708. end;
  709.  
  710. procedure ditdah;
  711. var
  712.   dd_choice : char;
  713.   exit : boolean;
  714. label endit;
  715. begin
  716.   mode:='DITS & DAHS';
  717.   exit_msg:=any_key;
  718.   statusline;
  719.   if firstpass then clrscr else begin writeln;writeln;end;
  720.   textcolor(cfgrec.hilite);
  721.   writeln('Learn DIT and DAH Sounds');
  722.   for i:=1 to 24 do write(chr(196));
  723.   textcolor(cfgrec.main_fg);
  724.   repeat
  725.     writeln;writeln;
  726.     writeln('* The DIT (short) sound : ');writeln;sendchr(' ',echo_no);
  727.     for i:=1 to 10 do begin
  728.       sendstr('E',echo_no);
  729.       if abort then goto endit;
  730.       write('DIT ');
  731.       sendstr(' ',echo_no);
  732.     end;
  733.     writeln;writeln;
  734.     writeln('* The DAH (long) sound :');writeln;sendchr(' ',echo_no);
  735.     for i:=1 to 10 do begin
  736.       sendstr('T',echo_no);
  737.       if abort then goto endit;
  738.       write('DAH ');
  739.       sendstr(' ',echo_no);
  740.     end;
  741.     writeln;writeln;
  742.     writeln('* DIT followed by DAH :');writeln;sendchr(' ',echo_no);
  743.     for i:=1 to 5 do begin
  744.       sendstr('E',echo_no);
  745.       if abort then goto endit;
  746.       write('DIT ');
  747.       sendstr(' T',echo_no);
  748.       if abort then goto endit;
  749.       write('DAH ');
  750.       sendstr(' ',echo_no);
  751.     end;
  752.     writeln;writeln;
  753.     writeln('* DAH followed by DIT :');writeln;sendchr(' ',echo_no);
  754.     for i:=1 to 5 do begin
  755.       sendstr('T',echo_no);
  756.       if abort then goto endit;
  757.       write('DAH ');
  758.       sendstr(' E',echo_no);
  759.       if abort then goto endit;
  760.       write('DIT ');
  761.       sendstr(' ',echo_no);
  762.     end;
  763.     writeln;writeln;
  764.     writeln('* Random DITS and DAHS :');writeln;sendchr(' ',echo_no);
  765.     for i:=1 to 18 do begin
  766.     repeat i:=random(3) until i>0;
  767.       case i of
  768.         1: begin sendstr('E',echo_no);write('DIT ');end;
  769.         2: begin sendstr('T',echo_no);write('DAH ');end;
  770.       end;
  771.       if abort then goto endit;
  772.       sendstr(' ',echo_no);
  773.     end;
  774.     writeln;writeln;write('* Repeat [Y/N] ? > ');
  775.     read(kbd,dd_choice);writeln(dd_choice);
  776.     if dd_choice in ['Y','y'] then exit:=false else exit:=true;
  777.   until exit;
  778.   endit:
  779.   writeln;writeln;write('* Press Any Key to Continue...');
  780.   repeat until keypressed;
  781. end;
  782.  
  783. procedure id_ditdah;
  784. var
  785.   id_choice : char;
  786.   id_choice_int : integer;
  787. begin
  788.   mode:='ID DITS & DAHS';
  789.   exit_msg:=esc_msg;
  790.   statusline;
  791.   if firstpass then clrscr else begin writeln;writeln;end;
  792.   textcolor(cfgrec.hilite);
  793.   writeln('Identify DIT and DAH Sounds');
  794.   for i:=1 to 27 do write(chr(196));
  795.   textcolor(cfgrec.main_fg);
  796.   writeln;
  797.   repeat
  798.     repeat rand_no:=random(3) until rand_no in [1,2];
  799.     case rand_no of
  800.       1: sendstr(' E',echo_no);
  801.       2: sendstr(' T',echo_no);
  802.     end;
  803.     writeln;write('* Was that a (1) DIT, or a (2) DAH ? > ');
  804.     id_choice:=' ';read(kbd,id_choice);
  805.     if id_choice<>esc then write(id_choice);
  806.     val(id_choice,id_choice_int,code);
  807.     if id_choice<>esc then
  808.       if id_choice in ['1','2'] then begin
  809.         if id_choice_int=rand_no then writeln('      YES !')
  810.         else begin
  811.           writeln('      NO !');
  812.           buzz;
  813.         end;
  814.       end;
  815.   until id_choice=esc;
  816. end;
  817.  
  818. procedure soundgroups;
  819. label endit;
  820. var
  821.   sg_choice : char;
  822.   exit : boolean;
  823.  
  824.   procedure groupletter(letter:char);
  825.   label endit;
  826.   begin
  827.      sendchr(letter,echo_yes);write(' ');
  828.      if abort then goto endit;
  829.      for i:=1 to 4 do begin
  830.        sendchr(letter,echo_no);
  831.        if abort then goto endit;
  832.      end;
  833.      sendstr(' ',echo_no);
  834.      endit:
  835.   end;
  836.  
  837. begin
  838.   mode:='SOUND GROUPS';
  839.   exit_msg:=any_key;
  840.   statusline;
  841.   if firstpass then clrscr else begin writeln;writeln;end;
  842.   textcolor(cfgrec.hilite);
  843.   writeln('Learn Character Sounds');
  844.   for i:=1 to 22 do write(chr(196));
  845.   textcolor(cfgrec.main_fg);
  846.   writeln;writeln;
  847.   repeat
  848.     writeln('* Group 1 :');writeln;sendchr(' ',echo_no);
  849.     groupletter('E');
  850.     groupletter('I');
  851.     groupletter('S');
  852.     groupletter('H');
  853.     groupletter('5');
  854.     sendline('EISH5',echo_yes);
  855.     if abort then goto endit;
  856.     writeln;writeln('* Group 2 :');writeln;sendchr(' ',echo_no);
  857.     groupletter('T');
  858.     groupletter('M');
  859.     groupletter('O');
  860.     groupletter('0');
  861.     sendline('TMO0',echo_yes);
  862.     if abort then goto endit;
  863.     writeln;writeln('* Group 3 :');writeln;sendchr(' ',echo_no);
  864.     groupletter('A');
  865.     groupletter('R');
  866.     groupletter('L');
  867.     groupletter('W');
  868.     groupletter('J');
  869.     groupletter('1');
  870.     groupletter('P');
  871.     sendline('ARLWJ1P',echo_yes);
  872.     if abort then goto endit;
  873.     writeln;writeln('* Group 4 :');writeln;sendchr(' ',echo_no);
  874.     groupletter('U');
  875.     groupletter('F');
  876.     groupletter('2');
  877.     groupletter('V');
  878.     groupletter('3');
  879.     groupletter('4');
  880.     sendline('UF2V34',echo_yes);
  881.     if abort then goto endit;
  882.     writeln;writeln('* Group 5 :');writeln;sendchr(' ',echo_no);
  883.     groupletter('N');
  884.     groupletter('D');
  885.     groupletter('B');
  886.     groupletter('6');
  887.     groupletter('8');
  888.     groupletter('9');
  889.     groupletter('X');
  890.     sendline('NDB689X',echo_yes);
  891.     if abort then goto endit;
  892.     writeln;writeln('* Group 6 :');writeln;sendchr(' ',echo_no);
  893.     groupletter('G');
  894.     groupletter('Q');
  895.     groupletter('Z');
  896.     groupletter('7');
  897.     groupletter('K');
  898.     groupletter('C');
  899.     groupletter('Y');
  900.     sendline('GQZ7KCY',echo_yes);
  901.     if abort then goto endit;
  902.     writeln;writeln('* Punctuation :');writeln;sendchr(' ',echo_no);
  903.     groupletter('.');
  904.     groupletter(',');
  905.     groupletter('?');
  906.     groupletter('/');
  907.     groupletter('-');
  908.     sendline('.,?/-',echo_yes);
  909.     if abort then goto endit;
  910.     writeln;writeln('* All the characters :');writeln;sendchr(' ',echo_no);
  911.     sendline('ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890.,?/-',echo_yes);
  912.     if abort then goto endit;
  913.     writeln;write('* Repeat [Y/N] ? > ');
  914.     read(kbd,sg_choice);writeln(sg_choice);
  915.     if sg_choice in ['Y','y'] then exit:=false else exit:=true;
  916.     if not exit then writeln;
  917.   until exit;
  918.   endit:
  919.   writeln;writeln;write('* Press Any Key to Continue...');
  920.   repeat until keypressed;
  921. end;
  922.  
  923. procedure sounds_test;
  924. const
  925.   group1 = 'EISH5';
  926.   group2 = 'TMO0';
  927.   group3 = 'ARLWJ1P';
  928.   group4 = 'UF2V34';
  929.   group5 = 'NDB689X';
  930.   group6 = 'GQZ7KCY';
  931.   group7 = '.,?/-';
  932.  
  933. var
  934.   st_choice : char;
  935.  
  936.   procedure sendrandom(group:line;withecho:boolean);begin
  937.     exit_msg:=esc_msg;
  938.     statusline;
  939.     randomize;
  940.     repeat
  941.       repeat
  942.         rand_no:=random(length(group)+1)
  943.       until rand_no in [1..length(group)];
  944.       ch:=group[rand_no];
  945.       sendchr(ch,echo_no);
  946.       write('* Which Character ? [',group,'] > ');
  947.       st_choice:=' ';read(kbd,st_choice);st_choice:=upcase(st_choice);
  948.       if st_choice<>esc then write(st_choice);
  949.       if st_choice<>esc then
  950.         if st_choice=ch then begin writeln('      YES !');writeln;end
  951.         else begin
  952.           writeln('      NO !');
  953.           buzz;
  954.           writeln;writeln('  The correct response is ',ch);writeln;
  955.           sendstr(' ',echo_no);
  956.         end;
  957.     until abort or (st_choice=esc);
  958.   end;
  959.  
  960. begin
  961.   mode:='SOUNDS TEST';
  962.   if firstpass then clrscr else begin writeln;writeln;end;
  963.   textcolor(cfgrec.hilite);
  964.   writeln('Test Character Sound Knowledge');
  965.   for i:=1 to 30 do write(chr(196));writeln;writeln;
  966.   textcolor(cfgrec.main_fg);
  967.   repeat
  968.     save_screen;
  969.     exit_msg:=esc_msg;
  970.     statusline;
  971.     repeat
  972.       open_wndo(27,6,53,18,cfgrec.box_fg,cfgrec.box_bg,'[ Select Group ]',blink_no);
  973.       textcolor(cfgrec.box_fg);
  974.       writeln('1 - ',group1);
  975.       writeln('2 - ',group2);
  976.       writeln('3 - ',group3);
  977.       writeln('4 - ',group4);
  978.       writeln('5 - ',group5);
  979.       writeln('6 - ',group6);
  980.       writeln('7 - ',group7);writeln;
  981.       write('  Choice > ');
  982.       st_choice:=' ';read(kbd,st_choice);if st_choice<>esc then write(st_choice);
  983.       st_choice:=upcase(st_choice);writeln;
  984.       if st_choice in [esc,'1','2','3','4','5','6','7'] then ok:=true else ok:=false;
  985.       if not ok then buzz;
  986.     until ok;
  987.     restore_screen;
  988.     case st_choice of
  989.       '1':sendrandom(group1,echo_yes);
  990.       '2':sendrandom(group2,echo_yes);
  991.       '3':sendrandom(group3,echo_yes);
  992.       '4':sendrandom(group4,echo_yes);
  993.       '5':sendrandom(group5,echo_yes);
  994.       '6':sendrandom(group6,echo_yes);
  995.       '7':sendrandom(group7,echo_yes);
  996.     end;
  997.   until (st_choice=esc) or abort;
  998. end;
  999.  
  1000. procedure learn;
  1001. var
  1002.   learn_choice : char;
  1003. begin
  1004.   repeat
  1005.     mode:='LEARN MENU';exit_msg:=esc_msg;
  1006.     statusline;
  1007.     save_screen;
  1008.     repeat
  1009.       open_wndo(27,6,53,16,cfgrec.box_fg,cfgrec.box_bg,'[ Learn Characters]',blink_no);
  1010.       textcolor(cfgrec.box_fg);
  1011.       writeln;
  1012.       writeln('<D>its & Dahs');
  1013.       writeln('<I>dentify Dits & Dahs');
  1014.       writeln('<S>ound Groups');
  1015.       writeln('<T>est Groups');
  1016.       writeln;
  1017.       write('Choice > ');read(kbd,learn_choice);write(learn_choice);
  1018.       if length(learn_choice)=0 then learn_choice:=esc;
  1019.       learn_choice:=upcase(learn_choice);
  1020.       if learn_choice in [esc,'D','I','S','T'] then ok:=true else ok:=false;
  1021.       if not ok then buzz;
  1022.     until ok;
  1023.     restore_screen;
  1024.     case learn_choice of
  1025.       'D':ditdah;
  1026.       'I':id_ditdah;
  1027.       'S':soundgroups;
  1028.       'T':sounds_test;
  1029.     end;
  1030.    firstpass:=false;
  1031.   until learn_choice=esc;
  1032. end;
  1033.  
  1034. procedure enter_message;
  1035. begin
  1036.   mode:='ENTER';
  1037.   exit_msg:=any_key;
  1038.   statusline;
  1039.   if firstpass then clrscr else begin writeln;writeln;end;
  1040.   textcolor(cfgrec.hilite);
  1041.   writeln('Enter Message');
  1042.   for i:=1 to 13 do write(chr(196));writeln;writeln;
  1043.   textcolor(cfgrec.main_fg);
  1044.   writeln('* Enter message to be typed');writeln;
  1045.   write('* > ');readln(textline);writeln('  ');
  1046.   if hide then write('* No Text Displayed...');
  1047.   sendline(textline,echo_yes);
  1048.   writeln;write('* Press Any Key to Continue...');
  1049.   repeat until keypressed;
  1050.   firstpass:=false;
  1051. end;
  1052.  
  1053. procedure sendwords;
  1054. begin
  1055.   mode:='WORDS';
  1056.   exit_msg:=any_key;
  1057.   statusline;
  1058.   abort:=false;
  1059.   if firstpass then clrscr else begin writeln;writeln;end;
  1060.   textcolor(cfgrec.hilite);
  1061.   writeln('Random Words');
  1062.   for i:=1 to 12 do write(chr(196));writeln;writeln;
  1063.   textcolor(cfgrec.main_fg);
  1064.   if hide then write('* No Text Displayed...');
  1065.   randomize;
  1066.   while not abort do begin
  1067.     textline:=words[random(numberwords)]+' ';
  1068.     if wherex>78-length(textline) then writeln;
  1069.     sendstr(textline,echo_no);
  1070.     if not hide then write(textline);
  1071.   end;
  1072.   writeln;writeln;write('* Press Any Key to Continue...');
  1073.   repeat until keypressed;
  1074.   firstpass:=false;
  1075. end;
  1076.  
  1077. function real2int(input:real):integer;
  1078. var
  1079.   number : integer;
  1080. begin
  1081.   number:=0;
  1082.   input:=int(input);
  1083.   while input>0 do begin input:=input-1; number:=number+1;end;
  1084.   real2int:=number;
  1085. end;
  1086.  
  1087. procedure enterspeed(send_spd,char_spd:real);
  1088. var
  1089.   dummy,space_spd : real;
  1090. begin
  1091.   dummy:=int(1170/char_spd);
  1092.   marktime:=real2int(dummy);
  1093.   space_spd:=(send_spd*char_spd)/(2*char_spd-send_spd);
  1094.   dummy:=int(1170/space_spd);
  1095.   space_marktime:=real2int(dummy);
  1096. end;
  1097.  
  1098. procedure set_speed;
  1099. var
  1100.   char_spd_str,send_spd_str : string[2];
  1101.  
  1102. begin
  1103.   mode:='SET SPEED';
  1104.   exit_msg:='';
  1105.   statusline;
  1106.   save_screen;
  1107.   open_wndo(27,7,51,16,cfgrec.box_fg,cfgrec.box_bg,'[ Set Speed ]',blink_no);
  1108.   textcolor(cfgrec.box_fg);
  1109.   repeat
  1110.     clrscr;writeln;
  1111.     writeln('Send Speed:');writeln;
  1112.     writeln('Range   = ',min_speed,'-',max_speed,' WPM.');
  1113.     writeln('Default = ',cfgrec.send_speed_str,' WPM.');
  1114.     writeln;
  1115.     write('Enter > ');
  1116.     ok:=false;
  1117.     read(send_spd_str);
  1118.     if length(send_spd_str)=0 then send_spd_str:=cfgrec.send_speed_str;
  1119.     val(send_spd_str,send_speed,code);
  1120.     if (send_speed>min_speed-1) and (send_speed<max_speed+1) then ok:=true;
  1121.     if not ok then buzz;
  1122.   until ok;
  1123.   repeat
  1124.     clrscr;writeln;
  1125.     writeln('Character Speed:');writeln;
  1126.     writeln('Range   = ',cfgrec.send_speed_str,'-',max_speed,' WPM.');
  1127.     writeln('Default = ',cfgrec.char_speed_str,' WPM.');
  1128.     writeln;
  1129.     write('Enter > ');
  1130.     ok:=false;
  1131.     read(char_spd_str);
  1132.     if length(char_spd_str)=0 then char_spd_str:=cfgrec.char_speed_str;
  1133.     val(char_spd_str,char_speed,code);
  1134.     if (char_speed>send_speed-1) and (char_speed<max_speed+1) then ok:=true;
  1135.     if not ok then buzz;
  1136.   until ok;
  1137.   enterspeed(send_speed,char_speed);
  1138.   assign(cfgfile,'CW.CFG');
  1139.   reset(cfgfile);
  1140.   read(cfgfile,cfgrec);
  1141.   cfgrec.send_speed_str:=send_spd_str;
  1142.   cfgrec.char_speed_str:=char_spd_str;
  1143.   rewrite(cfgfile);
  1144.   write(cfgfile,cfgrec);
  1145.   close(cfgfile);
  1146.   restore_screen;
  1147.   statusline;
  1148. end;
  1149.  
  1150. procedure tone;
  1151. var
  1152.   freq_str : string[4];
  1153. begin
  1154.   mode:='SET TONE';
  1155.   exit_msg:='';
  1156.   statusline;
  1157.   save_screen;
  1158.   repeat
  1159.     open_wndo(28,8,52,15,cfgrec.box_fg,cfgrec.box_bg,'[ Set Tone ]',blink_no);
  1160.     textcolor(cfgrec.box_fg);
  1161.     writeln;writeln('Range = 400-1200 Hz.');
  1162.     writeln('Default = ',cfgrec.tone_freq_str,' Hz.');
  1163.     writeln;
  1164.     write('Enter > ');
  1165.     read(freq_str);
  1166.     if length(freq_str)=0 then freq_str:=cfgrec.tone_freq_str;
  1167.     val(freq_str,freq,code);
  1168.     if (freq>399) and (freq<1201) then ok:=true else ok:=false;
  1169.     if not ok then buzz;
  1170.   until ok;
  1171.   assign(cfgfile,'CW.CFG');
  1172.   reset(cfgfile);
  1173.   read(cfgfile,cfgrec);
  1174.   cfgrec.tone_freq_str:=freq_str;
  1175.   rewrite(cfgfile);
  1176.   write(cfgfile,cfgrec);
  1177.   close(cfgfile);
  1178.   restore_screen;
  1179. end;
  1180.  
  1181. procedure parameters;
  1182. var
  1183.   param_choice : char;
  1184. begin
  1185.   mode:='PARAMETERS MENU';
  1186.   exit_msg:=esc_msg;
  1187.   statusline;
  1188.   save_screen;
  1189.   repeat
  1190.     open_wndo(29,8,51,16,cfgrec.box_fg,cfgrec.box_bg,'[ Set Parameters ]',blink_no);
  1191.     textcolor(cfgrec.box_fg);
  1192.     writeln;
  1193.     writeln('<S>peed');
  1194.     writeln('<T>one');
  1195.     writeln;
  1196.     write('Choice > ');read(kbd,param_choice);writeln(param_choice);
  1197.     if length(param_choice)=0 then param_choice:=esc;
  1198.     param_choice:=upcase(param_choice);
  1199.     if param_choice in [esc,'S','T'] then ok:=true else ok:=false;
  1200.     if not ok then buzz;
  1201.   until ok;
  1202.   restore_screen;
  1203.   case param_choice of
  1204.     'S':set_speed;
  1205.     'T':tone;
  1206.   end;
  1207. end;
  1208.  
  1209. procedure color_set;
  1210. var
  1211.   choice     : char;
  1212.   saveint    : integer;
  1213.   savestr    : line;
  1214.   select     : integer;
  1215.   select_str : string[1];
  1216.   temp       : string[40];
  1217.  
  1218. begin
  1219.   mode:='SET COLORS';
  1220.   exit_msg:='';
  1221.   statusline;
  1222.   assign(cfgfile,'CW.CFG');
  1223.   reset(cfgfile);
  1224.   read(cfgfile,cfgrec);
  1225.   rewrite(cfgfile);
  1226.   save_screen;
  1227.   open_wndo(10,7,70,18,cfgrec.box_fg,cfgrec.box_bg,'[ Color Set ]',blink_no);
  1228.   textcolor(cfgrec.box_fg);
  1229.   writeln;
  1230.   writeln('0 - Black  4 - Red       8 - Dk. Gray  12 - Lt. Red');
  1231.   writeln('1 - Blue   5 - Magenta   9 - Lt. Blue  13 - Lt. Magenta');
  1232.   writeln('2 - Green  6 - Brown    10 - Lt. Green 14 - Yellow');
  1233.   writeln('3 - Cyan   7 - Lt. Gray 11 - Lt. Cyan  15 - White');
  1234.   repeat
  1235.     clrscr;
  1236.     select:=cfgrec.main_bg;
  1237.     writeln('Enter main background color (0-7):');
  1238.     writeln('Current : ',cfgrec.main_bg);
  1239.     write('New     : ');readln(select_str);
  1240.     val(select_str,select,code);
  1241.     if select in [0..7] then ok:=true else ok:=false;
  1242.     if not ok then buzz;
  1243.   until ok;
  1244.   cfgrec.main_bg:=select;
  1245.   repeat
  1246.     clrscr;
  1247.     select:=cfgrec.main_fg;
  1248.     writeln('Enter main foreground color (0-15):');
  1249.     writeln('Current : ',cfgrec.main_fg);
  1250.     write('New     : ');readln(select_str);
  1251.     val(select_str,select,code);
  1252.     if (select in [0..15]) and (select<>cfgrec.main_bg) then ok:=true
  1253.     else ok:=false;
  1254.     if not ok then buzz;
  1255.   until ok;
  1256.   cfgrec.main_fg:=select;
  1257.   repeat
  1258.     clrscr;
  1259.     select:=cfgrec.box_bg;
  1260.     writeln('Enter box background color (0-7):');
  1261.     writeln('Current : ',cfgrec.box_bg);
  1262.     write('New     : ');readln(select_str);
  1263.     val(select_str,select,code);
  1264.     if select in [0..7] then ok:=true else ok:=false;
  1265.     if not ok then buzz;
  1266.   until ok;
  1267.   cfgrec.box_bg:=select;
  1268.   repeat
  1269.     clrscr;
  1270.     select:=cfgrec.box_fg;
  1271.     writeln('Enter box foreground color (0-15):');
  1272.     writeln('Current : ',cfgrec.box_fg);
  1273.     write('New       ');readln(select_str);
  1274.     val(select_str,select,code);
  1275.     if (select in [0..15]) and (select<>cfgrec.box_bg) then ok:=true
  1276.     else ok:=false;
  1277.     if not ok then buzz;
  1278.   until ok;
  1279.   cfgrec.box_fg:=select;
  1280.   repeat
  1281.     clrscr;
  1282.     select:=cfgrec.hilite;
  1283.     writeln('Enter text highlight color (0-15):');
  1284.     writeln('Current : ',cfgrec.hilite);
  1285.     write('New     : ');readln(select);
  1286.     val(select_str,select,code);
  1287.     if (select in [0..15]) and (select<>cfgrec.main_bg) then ok:=true
  1288.     else ok:=false;
  1289.     if not ok then buzz;
  1290.   until ok;
  1291.   cfgrec.hilite:=select;
  1292.   restore_screen;
  1293.   write(cfgfile,cfgrec);
  1294.   close(cfgfile);
  1295. end;
  1296.  
  1297. procedure speed_test;
  1298. var
  1299.   wordcount : integer;
  1300. begin
  1301.   mode:='SPEED TEST';
  1302.   exit_msg:='Any Key Stops Test';
  1303.   statusline;
  1304.   wordcount:=1;abort:=false;
  1305.   save_screen;
  1306.   open_wndo(8,6,71,18,cfgrec.box_fg,cfgrec.box_bg,'[ Test Speed ]',blink_no);
  1307.   textcolor(cfgrec.box_fg);
  1308.   writeln;
  1309.   writeln('* Count number of words sent in 60 seconds = WPM');
  1310.   writeln;
  1311.   while not abort and (wordcount<61) do begin
  1312.     sendstr('PARIS ',echo_yes);
  1313.     wordcount:=wordcount+1;
  1314.   end;
  1315.   writeln;writeln;
  1316.   write('* Press Any Key to Continue...');
  1317.   repeat until keypressed;
  1318.   restore_screen;
  1319. end;
  1320.  
  1321. procedure utilities;
  1322. var
  1323.   util_choice : char;
  1324. begin
  1325.   mode:='UTILITIES MENU';
  1326.   exit_msg:=esc_msg;
  1327.   statusline;
  1328.   save_screen;
  1329.   repeat
  1330.     open_wndo(30,8,50,16,cfgrec.box_fg,cfgrec.box_bg,'[ CW Utilities ]',blink_no);
  1331.     textcolor(cfgrec.box_fg);
  1332.     writeln;
  1333.     writeln('<C>olors');
  1334.     writeln('<H>ide Text');
  1335.     writeln('<S>peed Test');
  1336.     writeln;
  1337.     write('Choice > ');read(kbd,util_choice);writeln(util_choice);
  1338.     if length(util_choice)=0 then util_choice:=esc;
  1339.     util_choice:=upcase(util_choice);
  1340.     if util_choice in [esc,'C','H','S'] then ok:=true else ok:=false;
  1341.     if not ok then buzz;
  1342.   until ok;
  1343.   restore_screen;
  1344.   case util_choice of
  1345.     'C':color_set;
  1346.     'H':hide:=not hide;
  1347.     'S':speed_test;
  1348.   end;
  1349. end;
  1350.  
  1351. procedure cwscreen;
  1352. begin
  1353.   window(1,1,80,25);
  1354.   clrscr;
  1355.   for i:=1 to 24 do
  1356.     writeln('CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW');
  1357.   write('CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW CW');
  1358. end;
  1359.  
  1360. procedure config;
  1361. begin
  1362.   assign(cfgfile,'CW.CFG');
  1363.   {$I-} reset(cfgfile) {$I+};
  1364.   if ioresult<>0 then
  1365.     begin
  1366.       assign(cfgfile,'CW.CFG');
  1367.       rewrite(cfgfile);
  1368.       cfgrec.tone_freq_str:='500';
  1369.       cfgrec.send_speed_str:='5';
  1370.       cfgrec.char_speed_str:='13';
  1371.       cfgrec.main_bg:=0;
  1372.       cfgrec.main_fg:=15;
  1373.       cfgrec.box_bg:=0;
  1374.       cfgrec.box_fg:=15;
  1375.       cfgrec.hilite:=15;
  1376.       write(cfgfile,cfgrec);
  1377.     end;
  1378.   reset(cfgfile);
  1379.   read(cfgfile,cfgrec);
  1380.   close(cfgfile);
  1381. end;
  1382.  
  1383. procedure init_variables;
  1384. begin
  1385.   val(cfgrec.tone_freq_str,freq,code);
  1386.   val(cfgrec.send_speed_str,send_speed,code);
  1387.   val(cfgrec.char_speed_str,char_speed,code);
  1388.   firstpass:=true;
  1389.   hide:=false;
  1390. end;
  1391.  
  1392. begin
  1393.   config;
  1394.   init_variables;
  1395.   enterspeed(send_speed,char_speed);
  1396.   textcolor(cfgrec.main_fg);
  1397.   textbackground(cfgrec.main_bg);
  1398.   cwscreen;
  1399.   save_screen;
  1400.   open_wndo(15,5,65,20,cfgrec.box_fg,cfgrec.box_bg,'',blink_no);
  1401.   clrscr;writeln;
  1402.   writeln('                      CW');
  1403.   writeln('                   Ver. ',version);
  1404.   writeln('        A Morse Code Training Program');
  1405.   writeln('                      by');
  1406.   writeln('                M. Lee Murrah');
  1407.   writeln('                    WD5CID');
  1408.   writeln;
  1409.   writeln('Copyright 1986,87 M. Lee Murrah.  May be copied');
  1410.   writeln('and used for private, non-commercial purposes');
  1411.   writeln('without further permission of the author.');
  1412.   writeln;write('          Press Any Key to Continue...');
  1413.   close_wndo;
  1414.   repeat until keypressed;
  1415.   restore_screen;
  1416.   window(1,1,80,25);clrscr;
  1417.   gotoxy(1,24);for i:=1 to 80 do write(chr(196));
  1418.   window(1,1,80,23);
  1419.   save_screen;
  1420.   repeat
  1421.     mode:='CW MAIN MENU';
  1422.     exit_msg:='`X` Exits CW';
  1423.     statusline;
  1424.     save_screen;
  1425.     repeat
  1426.       open_wndo(23,2,57,22,cfgrec.box_fg,cfgrec.box_bg,'',blink_no);
  1427.       textcolor(cfgrec.box_fg);
  1428.       writeln;
  1429.       writeln('          CW MAIN MENU');
  1430.       writeln;
  1431.       writeln('        <D>isk File');
  1432.       writeln('        <E>nter Message');
  1433.       writeln('        <G>roups');
  1434.       writeln('        <K>eyboard Send');
  1435.       writeln('        <L>earn Chars');
  1436.       writeln('        <Q>SO');
  1437.       writeln('        <T>ype Test');
  1438.       writeln('        <W>ords');
  1439.       writeln;
  1440.       writeln('        <H>elp');
  1441.       writeln('        <I>nformation');
  1442.       writeln('        <P>arameters');
  1443.       writeln('        <U>tilities');writeln;
  1444.       write('         Select > ');
  1445.       read(kbd,menu_choice);writeln(menu_choice);menu_choice:=upcase(menu_choice);
  1446.       if menu_choice in ['D','E','F','G','H','I','K','L','P','Q','T','U','W','X']
  1447.         then ok:=true else ok:=false;
  1448.       if not ok then buzz;
  1449.     until ok;
  1450.     restore_screen;
  1451.     case menu_choice of
  1452.       'D':disk;
  1453.       'E':enter_message;
  1454.       'G':groups;
  1455.       'H':help;
  1456.       'I':info;
  1457.       'K':keyboard_send;
  1458.       'L':learn;
  1459.       'P':parameters;
  1460.       'Q':qso;
  1461.       'T':type_test;
  1462.       'U':utilities;
  1463.       'W':sendwords;
  1464.     end;
  1465.   until menu_choice in ['F','X'];
  1466.   if menu_choice='X' then begin
  1467.     cwscreen;
  1468.     open_wndo(28,9,51,15,cfgrec.box_fg,cfgrec.box_bg,'',blink_no);
  1469.     textcolor(cfgrec.box_fg);
  1470.     clrscr;writeln;writeln('Thanks for using CW');
  1471.     enterspeed(21,21);
  1472.     writeln;write('    ');
  1473.     sendline('73 DE WD5CID $',echo_yes);
  1474.     close_wndo;
  1475.   end;
  1476.   gotoxy(1,24);
  1477. end.
  1478.  
  1479. {speed calculation assumptions for type test function:
  1480.  
  1481.  o One bit is defined as one dot time.
  1482.  o A dot=1 bit, a dash=3 bits, a space between dots and dashes=1 bit,
  1483.    a space between characters=3 bits, and a space between words=7 bits.
  1484.  o The standard word PARIS has 31 bits or avg of 6.2 bits/character.
  1485.  o The average number of bits per character in the numbers and letters
  1486.    is 9.83.
  1487.  o The average character takes 9.83/6.2=1.58 times as long to send as the
  1488.    average character in the standard word.
  1489.  o A word is assumed to be 5 characters in length.
  1490.  o A 7 bit wordspace is added for every 5 characters --.71 character lengths
  1491.  o Thus, wpm can be estimated as recv_spee-d*60/5*1.58
  1492.  o Spaces between characters are ignored }